home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / tcqbsnip.zip / QIMCV.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-05-11  |  6.9 KB  |  247 lines
  1. DECLARE SUB MakeProg ()
  2. DECLARE SUB BMPLoad ()
  3. DECLARE SUB PCXLoad ()
  4. DECLARE SUB TGALoad ()
  5. DECLARE SUB Menu ()
  6. DEFINT A-Z
  7.  
  8. ' QIMCV.BAS
  9. ' Quick Image Converter 1.0
  10. ' by Tika Carr
  11. ' May 4, 1997
  12. '
  13. ' Freeware:
  14. '
  15. ' This program can be used as you please, as long as you give credit to
  16. ' the respective author(s).
  17. '
  18. ' No warranties or guarantees are expressed or implied.
  19. '
  20. ' Credits:
  21. '
  22. ' Tika Carr       (t.carr@juno.com)            Put together the pieces :)
  23. ' Dave Shea                                    BMP Decoder
  24. ' Jonathan Leger  (leger@mail.dtx.net)         PCX Decoder
  25. ' Erika Schulze   (100775.2275@compuserve.com) TGA Decoder
  26. ' Earl Montgomery                              Load/Save QIM format
  27. '
  28. ' Special thanks to others in the FidoNet QUIK_BAS Echo who helped
  29. ' contribute ideas to this project.
  30. '
  31. ' Description:
  32. '
  33. ' Quick Image Converter will convert 256 color 320 x 200 images saved in
  34. ' BMP, PCX or TGA format (sorry, no GIF due to licensing requirements).
  35. ' TGA images must be saved in uncompressed format. The result is a
  36. ' .QIM file, that can be quickly BLOADed into your programs:
  37. '
  38. ' Block 1:  QuickBasic BLOADable Image (64006 bytes)
  39. ' Block 2:  Palette information        (768 bytes)
  40. '   Total:  Total File Size            (64774)
  41. '
  42. ' This program also saves a .BAS file that you can merge into your programs
  43. ' and display the QIM file.
  44. '
  45. ' Revision History:
  46. '
  47. ' 1.0         5/4/1997       Put together different sources, and created
  48. '                            main and sub menus.
  49.  
  50. '**** Startup ****
  51. TYPE tga
  52.     info AS STRING * 1
  53.     clr  AS STRING * 1
  54.     img  AS STRING * 1
  55.     orig AS INTEGER
  56.     col  AS INTEGER
  57.     bits AS STRING * 1
  58.     xval AS INTEGER
  59.     yval AS INTEGER
  60.     w    AS INTEGER
  61.     h    AS INTEGER
  62.     pix  AS STRING * 1
  63.     desc AS STRING * 1
  64. END TYPE
  65.  
  66. '**** Main Program ****
  67.  
  68. SCREEN 0, 0, 0: WIDTH 80: COLOR 15, 1: CLS
  69.  
  70. PRINT TAB(25); CHR$(219) + CHR$(178) + CHR$(177) + CHR$(176);
  71. PRINT " Quick Image Converter ";
  72. PRINT CHR$(176) + CHR$(177) + CHR$(178) + CHR$(219)
  73. PRINT TAB(34); "by Tika Carr"
  74.  
  75. LOCATE 7
  76. PRINT TAB(25); "[L] Load an Image"
  77. PRINT TAB(25); "[D] Get a Directory Listing"
  78. PRINT TAB(25); "[Q] Quit Program"
  79. PRINT : PRINT : COLOR 10
  80. PRINT TAB(25); "While viewing picture:"
  81. PRINT
  82. PRINT TAB(25); "[S] Save screen"
  83. PRINT TAB(25); "[E] Exit to main menu without saving"
  84. PRINT TAB(25); "[Q] Quit program without saving"
  85.  
  86. DO: P$ = LCASE$(INPUT$(1)): LOOP WHILE INSTR("ldqv", P$) = 0
  87.  
  88. IF P$ = "q" THEN COLOR 7, 0: CLS : END
  89. IF P$ = "d" THEN COLOR 7, 0: CLS : SHELL "dir /w /p": SLEEP: RUN
  90.  
  91. COLOR 11: LOCATE 23, 3
  92. WHILE format$ <> "bmp" AND format$ <> "tga" AND format$ <> "pcx"
  93.     PRINT "File to load (MUST give BMP, PCX or TGA ext) ENTER = Menu: ";
  94.     LINE INPUT file$
  95.     IF file$ = "" THEN RUN
  96.     IF LEN(file$) > 4 THEN format$ = LCASE$(RIGHT$(file$, 3))
  97. WEND
  98.  
  99. LOCATE 23, 3: PRINT SPACE$(70); : LOCATE 23, 3
  100. PRINT "Image Filename (no ext): "; : LINE INPUT img$
  101. LOCATE 23, 3: PRINT SPACE$(70); : LOCATE 23, 3
  102. PRINT "BASIC Program Name (no ext) or ENTER for same as Image: ";
  103. LINE INPUT BAS$
  104.  
  105. IF BAS$ = "" THEN BAS$ = img$ + ".BAS" ELSE BAS$ = BAS$ + ".BAS"
  106. img$ = img$ + ".QIM"
  107.  
  108. SCREEN 13
  109.  
  110. '**** Load A BMP Image
  111. IF format$ = "bmp" THEN
  112.     LOCATE 10, 5: PRINT "Please wait for image to load."
  113.     SLEEP 2: CLS
  114.     OPEN file$ FOR BINARY AS #1
  115.         h$ = SPACE$(14): s$ = SPACE$(4)
  116.         GET #1, 1, h$: GET #1, 15, s$: bz = CVI(s$)
  117.         IF bz = 12 THEN
  118.             P$ = SPACE$(768)
  119.         ELSEIF bz = 40 THEN P$ = SPACE$(1024)
  120.         ELSE SCREEN 0, 0, 0: WIDTH 80: CLS : PRINT "Unable to load BMP image.": END
  121.         END IF
  122.         i$ = SPACE$(bz): GET #1, 15, i$: nb = CVI(MID$(i$, 15, 4))
  123.         IF nb <> 8 THEN END
  124.         GET #1, bz + 15, P$
  125.         IF bz = 40 THEN ng = 4 ELSE ng = 3
  126.         FOR x = 1 TO LEN(P$) STEP ng
  127.             b# = INT((ASC(MID$(P$, x, 1))) / 4)
  128.             g# = INT((ASC(MID$(P$, x + 1, 1))) / 4)
  129.             r# = INT((ASC(MID$(P$, x + 2, 1))) / 4)
  130.             c# = b# * 65536# + g# * 256# + r#: PALETTE ((x - 1) / ng), c#
  131.         NEXT
  132.         y = 199: d$ = " "
  133.         WHILE y >= 0
  134.             x = 0: WHILE x < 320: GET 1, , d$: PSET (x, y), ASC(d$): x = x + 1: WEND
  135.             y = y - 1
  136.         WEND
  137.     CLOSE #1
  138. END IF
  139.  
  140. '**** Load a PCX Image
  141. IF format$ = "pcx" THEN
  142.     DIM q AS STRING * 768, ver AS STRING * 1
  143.  
  144.     OPEN file$ FOR BINARY AS #1
  145.         GET #1, 2, ver
  146.         IF ASC(ver) <> 5 THEN
  147.             SCREEN 0, 0, 0, 0: WIDTH 80: CLS
  148.             PRINT "Unable to load PCX Image"
  149.             END
  150.         END IF
  151.         GET #1, LOF(1) - 767, q
  152.         FOR i = 1 TO 768 STEP 3: OUT &H3C8, P
  153.             r = INT(ASC(MID$(q, i, 1)) / 4): OUT &H3C9, r
  154.             g = INT(ASC(MID$(q, i + 1, 1)) / 4): OUT &H3C9, g
  155.             b = INT(ASC(MID$(q, i + 2, 1)) / 4): OUT &H3C9, b
  156.             P = P + 1
  157.         NEXT
  158.         SEEK #1, 129
  159.         ds = 2000: dat$ = INPUT$(ds, 1): dc = 1
  160.         FOR half = 1 TO 2
  161.             DEF SEG = &HA000 + ofs
  162.             FOR c = 0 TO 31999
  163.                 IF dc > ds THEN dat$ = INPUT$(ds, 1): dc = 1
  164.                 cl = ASC(MID$(dat$, dc, 1))
  165.                 dc = dc + 1
  166.                 IF dc > ds THEN : dat$ = INPUT$(ds, 1): dc = 1
  167.                 IF cl > 192 THEN
  168.                     LPS = cl - 192: cl = ASC(MID$(dat$, dc, 1)): dc = dc + 1
  169.                     FOR L = LPS TO 1 STEP -1: POKE c, cl: c = c + 1: NEXT: c = c - 1
  170.                 ELSE POKE c, cl
  171.                 END IF
  172.             NEXT
  173.             ofs = ofs + &H7D0
  174.         NEXT
  175.         DEF SEG
  176.     CLOSE #1
  177. END IF
  178.  
  179. '**** Load a TGA Image
  180. IF format$ = "tga" THEN
  181.     DIM hdr AS tga
  182.  
  183.     OPEN file$ FOR BINARY AS #1: GET #1, 1, hdr: CLOSE #1
  184.  
  185.     OPEN file$ FOR BINARY AS #1
  186.         IF ASC(hdr.clr) <> 1 OR ASC(hdr.img) <> 1 THEN
  187.             SCREEN 0, 0, 0, 0: WIDTH 80: CLS
  188.             PRINT "Unable to load TGA file."
  189.             END
  190.         END IF
  191.         dcl = hdr.col * ASC(hdr.bits) / 8: dcs& = 19 + ASC(hdr.info)
  192.         dce& = dcs& + dcl%
  193.         SEEK #1, dcs&
  194.         FOR reg = 0 TO 255
  195.             t$ = SPACE$(3): GET #1, , t$
  196.             r = ASC(MID$(t$, 3)) \ 4: g = ASC(MID$(t$, 2)) \ 4
  197.             b = ASC(MID$(t$, 1)) \ 4
  198.             OUT &H3C8, reg: OUT &H3C9, r: OUT &H3C9, g: OUT &H3C9, b
  199.         NEXT
  200.         SEEK #1, dce&: t$ = SPACE$(1)
  201.         FOR y = 0 TO hdr.h - 1: FOR x = 0 TO hdr.w - 1
  202.             GET #1, , t$: col = ASC(t$): PSET (x, y), col
  203.         NEXT x, y
  204.     CLOSE #1
  205. END IF
  206.  
  207. '**** Save Image (or Exit to menu or quit) ****'
  208. DO
  209.     QI$ = LCASE$(INPUT$(1))
  210.  
  211.     '**** Save to .QIM File Format ****
  212.  
  213.     IF QI$ = "s" THEN  'Save Screen & palette
  214.         DEF SEG = &HA000 + 4000
  215.         OUT &H3C7, 0
  216.         FOR x = 0 TO 767: cv = INP(&H3C9): POKE x, cv: NEXT
  217.         DEF SEG = &HA000
  218.         BSAVE img$, 0, 63999 + 768
  219.  
  220.         '**** Save a .BAS file loader
  221.         OPEN BAS$ FOR OUTPUT AS #1
  222.             PRINT #1, "' Loader for " + img$
  223.             PRINT #1, "' by Earl Montgomery"
  224.             PRINT #1, ""
  225.             PRINT #1, "DEFINT A-Z"
  226.             PRINT #1, ""
  227.             PRINT #1, "SCREEN 13"
  228.             PRINT #1, "OUT &H3C8, 0"
  229.             PRINT #1, "FOR x = 0 TO 767: OUT &H3C9, 0: NEXT"
  230.             PRINT #1, "DEF SEG = &HA000"
  231.             PRINT #1, "BLOAD " + CHR$(34) + img$ + CHR$(34) + ", 0"
  232.             PRINT #1, "DEF SEG = &HA000 + 4000"
  233.             PRINT #1, "OUT &H3C8, 0"
  234.             PRINT #1, "FOR x = 0 TO 767: P = PEEK(x): OUT &H3C9, P: NEXT"
  235.             PRINT #1, ""
  236.             PRINT #1, "SLEEP"
  237.             PRINT #1, "SCREEN 0, 0, 0, 0: WIDTH 80: COLOR 7,0: CLS: END"
  238.         CLOSE #1
  239.     END IF
  240.      
  241.     IF QI$ = "q" THEN  'Exit program without saving
  242.         SCREEN 0, 0, 0, 0: WIDTH 80: CLS : END
  243.     END IF
  244.     RUN
  245. LOOP WHILE INSTR("seq", QI$) = 0
  246.  
  247.